Syntax10.Scn.Fnt
MODULE Colors; (** ww 23 Jan 91 / RC 19.9.91**)
  IMPORT Display, Texts, TextFrames, Viewers, MenuViewers, Oberon, Input, Files;
  CONST Menu = "System.Close  System.Copy  System.Grow";
    Cols = 16;  (* Number of Colors to be represented *)
    MaxInt = 255;  (* maximum value for intensity *)
    Left = 2; Middle = 1; Right = 0;  (* mouse buttons *)
    Comp = 3; H = 0; L = 1; S = 2;  R = 0; G = 1; B = 2;  (* Just for clarifying some things later ... *)
  TYPE
    Frame = POINTER TO FrameDesc;
    FrameDesc = RECORD(Display.FrameDesc)
      beg: ARRAY 256 OF INTEGER;
      n: INTEGER
    END;
    Components = ARRAY Comp OF REAL;
    Color = RECORD
      rgb: Components;
      nr: INTEGER
    END;
    EditFrame = POINTER TO EditFrameDesc;
    EditFrameDesc = RECORD(Display.FrameDesc)
      beg: ARRAY Comp + 1 OF INTEGER;
      col: Color;
    END;
    Msg = RECORD(Display.FrameMsg) END;
  VAR w: Texts.Writer; task: Oberon.Task; grey: ARRAY 3 OF Display.Pattern;
    PROCEDURE Load*;
      VAR par: Oberon.ParList;
		S: Texts.Scanner;
        f: Files.File; R: Files.Rider;
        col: SHORTINT; red, green, blue: CHAR;
    BEGIN
      Texts.WriteString(w, "Colors.Load ");
	  par := Oberon.Par;
	  Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
	  IF S.class = Texts.Name THEN
        Texts.WriteString(w, S.s);
        f := Files.Old(S.s);
        IF f # NIL THEN
		  Files.Set(R, f, 0); col := 0;
          REPEAT
            Files.Read(R, red); Files.Read(R, green); Files.Read(R, blue);
            Display.SetColor(col, ORD(red), ORD(green), ORD(blue));
            INC(col)
          UNTIL col = 16
        ELSE Texts.WriteString(w, " not found")
        END
      ELSE Texts.WriteString(w, " no name")
      END;
      Texts.WriteLn(w);
      Texts.Append(Oberon.Log, w.buf)
    END Load;
  PROCEDURE Int(v: REAL): INTEGER;
  BEGIN RETURN SHORT(ENTIER(MaxInt * v))
  END Int;
  PROCEDURE UpdateDisp(VAR col: Color);
  BEGIN Display.SetColor(col.nr, Int(col.rgb[0]), Int(col.rgb[1]), Int(col.rgb[2]))
  END UpdateDisp;
  PROCEDURE Change(VAR col: Color): BOOLEAN;
    VAR d: ARRAY Comp OF INTEGER;  v: REAL; i: INTEGER; change: BOOLEAN;
  BEGIN Display.GetColor(col.nr, d[0], d[1], d[2]); i := 0; change := FALSE;
    WHILE i < Comp DO v := Int(col.rgb[i]);
      IF v # d[i] THEN change := TRUE; col.rgb[i] := d[i] / MaxInt END;
      INC(i)
    END;
    RETURN change
  END Change;
  PROCEDURE ShowRGB(f: EditFrame);
    VAR x, w, r, i, h: INTEGER;
  BEGIN w := f.W DIV (Comp + 1) + 1; r := f.W - w * (Comp + 1); i := 0; x := 0; f.beg[i] := x; Oberon.RemoveMarks(f.X, f.Y, f.W, f.H);
    WHILE i < Comp DO h := SHORT(ENTIER(f.H * f.col.rgb[i])); DEC(r);
      IF r = 0 THEN DEC(w) END;
      Display.ReplConst(i + 1, f.X + x, f.Y, w, h, Display.replace);
      Display.ReplConst(Display.black, f.X + x, f.Y + h, w, f.H - h, Display.replace);
      INC(x, w); INC(i); f.beg[i] := x
    END;
    Display.ReplConst(f.col.nr, f.X + x, f.Y, f.W - x, f.H, Display.replace)
  END ShowRGB;
  PROCEDURE EditRGB(f: EditFrame; x, y: INTEGER; keys: SET);
    VAR backUp: Color; m: Msg;  keySum: SET; last: REAL; i: INTEGER;
  BEGIN keySum := keys; x := x - f.X; i := 1; backUp := f.col;
    WHILE (i <= Comp) & (f.beg[i] < x) DO INC(i) END;
    IF i <= Comp THEN DEC(i); last := -1;
      REPEAT Input.Mouse(keys, x, y); keySum := keySum + keys;
        Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, x, y); y := y - f.Y;
        IF y < 0 THEN y := 0 ELSIF y > f.H THEN y := f.H END;
        f.col.rgb[i] := y / f.H;
        IF f.col.rgb[i] # last THEN UpdateDisp(f.col); last := f.col.rgb[i];
          Oberon.RemoveMarks(f.X, f.Y, f.W, f.H);
          Display.ReplConst(i + 1, f.X + f.beg[i], f.Y, f.beg[i + 1] - f.beg[i] , y, Display.replace);
          Display.ReplConst(Display.black, f.X + f.beg[i], f.Y + y, f.beg[i + 1] - f.beg[i] , f.H - y, Display.replace);
          Viewers.Broadcast(m)
        END
      UNTIL keys = {};
      IF keySum # {Left} THEN f.col := backUp; UpdateDisp(backUp); ShowRGB(f) END
    END
  END EditRGB;
  PROCEDURE HandleEdit(f: Display.Frame; VAR m: Display.FrameMsg);
    VAR frame: EditFrame; v: Components;
  BEGIN
    WITH f: EditFrame DO
      IF m IS Oberon.InputMsg THEN
        WITH m: Oberon.InputMsg DO
          IF m.id = Oberon.track THEN
            IF m.keys = {} THEN Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, m.X, m.Y);
            ELSE EditRGB(f, m.X, m.Y, m.keys)
			END
          END
        END
      ELSIF (m IS Msg) & Change(f.col) THEN ShowRGB(f)
      ELSIF m IS Oberon.CopyMsg THEN NEW(frame); frame^ := f^; m(Oberon.CopyMsg).F := frame
      ELSIF m IS MenuViewers.ModifyMsg THEN
        WITH m: MenuViewers.ModifyMsg DO f.Y := m.Y; f.H := m.H;
          ShowRGB(f)
        END
      END
    END
  END HandleEdit;
  PROCEDURE EditColor(colNr: INTEGER; rgb: BOOLEAN);
    VAR f: EditFrame;  v: Viewers.Viewer;  col: Color;  x, y: INTEGER; dummy: BOOLEAN;
  BEGIN col.nr := colNr; dummy := Change(col);
    NEW(f); f.col := col; f.handle := HandleEdit; Oberon.AllocateSystemViewer(Oberon.Mouse.X, x, y);
    v := MenuViewers.New(TextFrames.NewMenu("Color", Menu), f, TextFrames.menuH, x, y);
    Texts.Write(w, " "); Texts.WriteInt(w, colNr, 0); Texts.Insert(v.dsc(TextFrames.Frame).text, 5, w.buf)
  END EditColor;
  PROCEDURE Show(f: Frame);
    VAR i, r, n, w, x: INTEGER;
  BEGIN n := f.n; w := f.W DIV n; r := f.W - w * n; i := 0; x := 0; INC(w);
    WHILE i < n DO f.beg[i] := x;
      IF r = 0 THEN DEC(w) END;
      Display.ReplConst(i, f.X + x, f.Y, w, f.H, Display.replace); INC(x, w); INC(i); DEC(r)
    END
  END Show;
  PROCEDURE Edit(f: Frame; x, y: INTEGER; keys: SET);
    VAR keySum: SET; i: INTEGER;
  BEGIN keySum := keys;
    REPEAT Input.Mouse(keys, x, y); keySum := keySum + keys;
      Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, x, y)
    UNTIL keys = {};
    IF (keySum = {Left}) OR (keySum = {Right}) THEN i := 1; x := x - f.X;
      WHILE (i < f.n) & (f.beg[i] < x) DO INC(i) END;
      EditColor(i-1, keySum = {Left})
    END
  END Edit;
  PROCEDURE Handler(f: Display.Frame; VAR m: Display.FrameMsg);
    VAR frame: Frame;
  BEGIN
    WITH f: Frame DO
      IF m IS Oberon.InputMsg THEN
        WITH m: Oberon.InputMsg DO
          IF m.id = Oberon.track THEN
            IF m.keys = {} THEN Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, m.X, m.Y)
            ELSE Edit(f, m.X, m.Y, m.keys)
            END
          END
        END
      ELSIF m IS Oberon.CopyMsg THEN NEW(frame); frame^ := f^; m(Oberon.CopyMsg).F := frame
      ELSIF m IS MenuViewers.ModifyMsg THEN
        WITH m: MenuViewers.ModifyMsg DO f.Y := m.Y; f.H := m.H; Show(f) END
      END
    END
  END Handler;
  PROCEDURE Open*;
    VAR s: Texts.Scanner;  f: Frame; v: Viewers.Viewer;  x, y, n: INTEGER;
  BEGIN Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s);
    IF s.class = Texts.Int THEN n := SHORT(s.i) ELSE n := Cols END;
    Oberon.AllocateSystemViewer(Oberon.Mouse.X, x, y); NEW(f); f.handle := Handler; f.n := n;
    v := MenuViewers.New(TextFrames.NewMenu("Colors", Menu), f, TextFrames.menuH, x, y)
  END Open;
  PROCEDURE* Activate;
    VAR m: Msg;
  BEGIN Viewers.Broadcast(m)
  END Activate;
BEGIN Texts.OpenWriter(w);
  NEW(task); task.handle := Activate; task.safe := FALSE; Oberon.Install(task);
  grey[0] := Display.grey0; grey[1] := Display.grey1; grey[2] := Display.grey2
END Colors.
Colors.Open